home *** CD-ROM | disk | FTP | other *** search
/ Planet Source Code Jumbo …e CD Visual Basic 1 to 7 / 4_2005-2006.ISO / data / Zips / A_Connect_2019789142006.psc / Connect 4 / frmMain.frm < prev    next >
Text File  |  2005-10-21  |  40KB  |  1,143 lines
  1. VERSION 5.00
  2. Object = "{F9043C88-F6F2-101A-A3C9-08002B2F49FB}#1.2#0"; "COMDLG32.OCX"
  3. Object = "{831FDD16-0C5C-11D2-A9FC-0000F8754DA1}#2.0#0"; "MSCOMCTL.OCX"
  4. Begin VB.Form frmMain 
  5.    BackColor       =   &H00FF8080&
  6.    BorderStyle     =   1  'Fixed Single
  7.    Caption         =   "Connect 4"
  8.    ClientHeight    =   5310
  9.    ClientLeft      =   150
  10.    ClientTop       =   540
  11.    ClientWidth     =   9315
  12.    Icon            =   "frmMain.frx":0000
  13.    LinkTopic       =   "Form1"
  14.    MaxButton       =   0   'False
  15.    ScaleHeight     =   5310
  16.    ScaleWidth      =   9315
  17.    StartUpPosition =   2  'CenterScreen
  18.    Begin VB.TextBox Text1 
  19.       Height          =   2535
  20.       Left            =   7560
  21.       Locked          =   -1  'True
  22.       MultiLine       =   -1  'True
  23.       ScrollBars      =   2  'Vertical
  24.       TabIndex        =   5
  25.       Top             =   2520
  26.       Width           =   1575
  27.    End
  28.    Begin MSComctlLib.ImageList ImageList1 
  29.       Left            =   480
  30.       Top             =   4080
  31.       _ExtentX        =   1005
  32.       _ExtentY        =   1005
  33.       BackColor       =   -2147483643
  34.       ImageWidth      =   16
  35.       ImageHeight     =   16
  36.       MaskColor       =   12632256
  37.       _Version        =   393216
  38.       BeginProperty Images {2C247F25-8591-11D1-B16A-00C0F0283628} 
  39.          NumListImages   =   7
  40.          BeginProperty ListImage1 {2C247F27-8591-11D1-B16A-00C0F0283628} 
  41.             Picture         =   "frmMain.frx":3D32
  42.             Key             =   ""
  43.          EndProperty
  44.          BeginProperty ListImage2 {2C247F27-8591-11D1-B16A-00C0F0283628} 
  45.             Picture         =   "frmMain.frx":4B84
  46.             Key             =   ""
  47.          EndProperty
  48.          BeginProperty ListImage3 {2C247F27-8591-11D1-B16A-00C0F0283628} 
  49.             Picture         =   "frmMain.frx":50C6
  50.             Key             =   ""
  51.          EndProperty
  52.          BeginProperty ListImage4 {2C247F27-8591-11D1-B16A-00C0F0283628} 
  53.             Picture         =   "frmMain.frx":5608
  54.             Key             =   ""
  55.          EndProperty
  56.          BeginProperty ListImage5 {2C247F27-8591-11D1-B16A-00C0F0283628} 
  57.             Picture         =   "frmMain.frx":645A
  58.             Key             =   ""
  59.          EndProperty
  60.          BeginProperty ListImage6 {2C247F27-8591-11D1-B16A-00C0F0283628} 
  61.             Picture         =   "frmMain.frx":699C
  62.             Key             =   ""
  63.          EndProperty
  64.          BeginProperty ListImage7 {2C247F27-8591-11D1-B16A-00C0F0283628} 
  65.             Picture         =   "frmMain.frx":6EDE
  66.             Key             =   ""
  67.          EndProperty
  68.       EndProperty
  69.    End
  70.    Begin MSComctlLib.Toolbar Toolbar1 
  71.       Align           =   1  'Align Top
  72.       Height          =   360
  73.       Left            =   0
  74.       TabIndex        =   2
  75.       Top             =   0
  76.       Width           =   9315
  77.       _ExtentX        =   16431
  78.       _ExtentY        =   635
  79.       ButtonWidth     =   609
  80.       ButtonHeight    =   582
  81.       Appearance      =   1
  82.       Style           =   1
  83.       ImageList       =   "ImageList1"
  84.       _Version        =   393216
  85.       BeginProperty Buttons {66833FE8-8583-11D1-B16A-00C0F0283628} 
  86.          NumButtons      =   8
  87.          BeginProperty Button1 {66833FEA-8583-11D1-B16A-00C0F0283628} 
  88.             Key             =   "new"
  89.             Object.ToolTipText     =   "New Game"
  90.             ImageIndex      =   1
  91.          EndProperty
  92.          BeginProperty Button2 {66833FEA-8583-11D1-B16A-00C0F0283628} 
  93.             Key             =   "load"
  94.             Object.ToolTipText     =   "Load Game"
  95.             ImageIndex      =   2
  96.          EndProperty
  97.          BeginProperty Button3 {66833FEA-8583-11D1-B16A-00C0F0283628} 
  98.             Key             =   "save"
  99.             Object.ToolTipText     =   "Save Game"
  100.             ImageIndex      =   3
  101.          EndProperty
  102.          BeginProperty Button4 {66833FEA-8583-11D1-B16A-00C0F0283628} 
  103.             Style           =   3
  104.          EndProperty
  105.          BeginProperty Button5 {66833FEA-8583-11D1-B16A-00C0F0283628} 
  106.             Key             =   "move"
  107.             Object.ToolTipText     =   "Move Now"
  108.             ImageIndex      =   4
  109.          EndProperty
  110.          BeginProperty Button6 {66833FEA-8583-11D1-B16A-00C0F0283628} 
  111.             Key             =   "undo"
  112.             Object.ToolTipText     =   "Undo Move"
  113.             ImageIndex      =   5
  114.          EndProperty
  115.          BeginProperty Button7 {66833FEA-8583-11D1-B16A-00C0F0283628} 
  116.             Key             =   "redo"
  117.             Object.ToolTipText     =   "Redo Move"
  118.             ImageIndex      =   6
  119.          EndProperty
  120.          BeginProperty Button8 {66833FEA-8583-11D1-B16A-00C0F0283628} 
  121.             Key             =   "stop"
  122.             Object.ToolTipText     =   "Stop Thinking"
  123.             ImageIndex      =   7
  124.          EndProperty
  125.       EndProperty
  126.    End
  127.    Begin MSComDlg.CommonDialog CommonDialog1 
  128.       Left            =   0
  129.       Top             =   4200
  130.       _ExtentX        =   847
  131.       _ExtentY        =   847
  132.       _Version        =   393216
  133.    End
  134.    Begin VB.PictureBox PicPieces 
  135.       AutoSize        =   -1  'True
  136.       Height          =   2445
  137.       Left            =   0
  138.       Picture         =   "frmMain.frx":7D30
  139.       ScaleHeight     =   159
  140.       ScaleMode       =   3  'Pixel
  141.       ScaleWidth      =   43
  142.       TabIndex        =   1
  143.       Top             =   720
  144.       Visible         =   0   'False
  145.       Width           =   705
  146.    End
  147.    Begin VB.PictureBox Picboard 
  148.       AutoRedraw      =   -1  'True
  149.       AutoSize        =   -1  'True
  150.       BorderStyle     =   0  'None
  151.       Height          =   4350
  152.       Left            =   240
  153.       Picture         =   "frmMain.frx":CF6E
  154.       ScaleHeight     =   290
  155.       ScaleMode       =   3  'Pixel
  156.       ScaleWidth      =   468
  157.       TabIndex        =   0
  158.       Top             =   720
  159.       Width           =   7020
  160.       Begin VB.Image Image1 
  161.          Height          =   3615
  162.          Index           =   0
  163.          Left            =   1200
  164.          Top             =   120
  165.          Width           =   495
  166.       End
  167.       Begin VB.Image Image1 
  168.          Height          =   3615
  169.          Index           =   1
  170.          Left            =   1875
  171.          Top             =   120
  172.          Width           =   495
  173.       End
  174.       Begin VB.Image Image1 
  175.          Height          =   3615
  176.          Index           =   2
  177.          Left            =   2580
  178.          Top             =   120
  179.          Width           =   495
  180.       End
  181.       Begin VB.Image Image1 
  182.          Height          =   3615
  183.          Index           =   3
  184.          Left            =   3240
  185.          Top             =   120
  186.          Width           =   495
  187.       End
  188.       Begin VB.Image Image1 
  189.          Height          =   3615
  190.          Index           =   4
  191.          Left            =   3960
  192.          Top             =   120
  193.          Width           =   495
  194.       End
  195.       Begin VB.Image Image1 
  196.          Height          =   3615
  197.          Index           =   5
  198.          Left            =   4635
  199.          Top             =   120
  200.          Width           =   495
  201.       End
  202.       Begin VB.Image Image1 
  203.          Height          =   3615
  204.          Index           =   6
  205.          Left            =   5325
  206.          Top             =   120
  207.          Width           =   495
  208.       End
  209.    End
  210.    Begin VB.Frame Frame1 
  211.       BackColor       =   &H00FF8080&
  212.       Height          =   4695
  213.       Left            =   120
  214.       TabIndex        =   3
  215.       Top             =   480
  216.       Width           =   7215
  217.    End
  218.    Begin VB.Shape Shape1 
  219.       BorderColor     =   &H00E0E0E0&
  220.       Height          =   4575
  221.       Left            =   7440
  222.       Top             =   600
  223.       Width           =   1815
  224.    End
  225.    Begin VB.Label Label1 
  226.       BackStyle       =   0  'Transparent
  227.       Caption         =   "Player to move:"
  228.       BeginProperty Font 
  229.          Name            =   "MS Sans Serif"
  230.          Size            =   8.25
  231.          Charset         =   178
  232.          Weight          =   700
  233.          Underline       =   0   'False
  234.          Italic          =   0   'False
  235.          Strikethrough   =   0   'False
  236.       EndProperty
  237.       Height          =   255
  238.       Left            =   7680
  239.       TabIndex        =   4
  240.       Top             =   720
  241.       Width           =   1335
  242.    End
  243.    Begin VB.Image Image3 
  244.       Height          =   465
  245.       Left            =   8040
  246.       Picture         =   "frmMain.frx":70628
  247.       Top             =   1080
  248.       Width           =   465
  249.    End
  250.    Begin VB.Label Label5 
  251.       Alignment       =   2  'Center
  252.       BackColor       =   &H00FFFFFF&
  253.       BackStyle       =   0  'Transparent
  254.       BeginProperty Font 
  255.          Name            =   "MS Sans Serif"
  256.          Size            =   8.25
  257.          Charset         =   178
  258.          Weight          =   700
  259.          Underline       =   0   'False
  260.          Italic          =   0   'False
  261.          Strikethrough   =   0   'False
  262.       EndProperty
  263.       Height          =   255
  264.       Left            =   8160
  265.       TabIndex        =   9
  266.       Top             =   2040
  267.       Width           =   735
  268.    End
  269.    Begin VB.Label Label4 
  270.       Alignment       =   2  'Center
  271.       BackColor       =   &H00FFFFFF&
  272.       BackStyle       =   0  'Transparent
  273.       BeginProperty Font 
  274.          Name            =   "MS Sans Serif"
  275.          Size            =   8.25
  276.          Charset         =   178
  277.          Weight          =   700
  278.          Underline       =   0   'False
  279.          Italic          =   0   'False
  280.          Strikethrough   =   0   'False
  281.       EndProperty
  282.       Height          =   255
  283.       Left            =   8160
  284.       TabIndex        =   8
  285.       Top             =   1680
  286.       Width           =   735
  287.    End
  288.    Begin VB.Label Label3 
  289.       BackStyle       =   0  'Transparent
  290.       Caption         =   "Value:"
  291.       BeginProperty Font 
  292.          Name            =   "MS Sans Serif"
  293.          Size            =   8.25
  294.          Charset         =   178
  295.          Weight          =   700
  296.          Underline       =   0   'False
  297.          Italic          =   0   'False
  298.          Strikethrough   =   0   'False
  299.       EndProperty
  300.       Height          =   255
  301.       Left            =   7560
  302.       TabIndex        =   7
  303.       Top             =   2040
  304.       Width           =   615
  305.    End
  306.    Begin VB.Label Label2 
  307.       BackStyle       =   0  'Transparent
  308.       Caption         =   "Depth:"
  309.       BeginProperty Font 
  310.          Name            =   "MS Sans Serif"
  311.          Size            =   8.25
  312.          Charset         =   178
  313.          Weight          =   700
  314.          Underline       =   0   'False
  315.          Italic          =   0   'False
  316.          Strikethrough   =   0   'False
  317.       EndProperty
  318.       Height          =   255
  319.       Left            =   7560
  320.       TabIndex        =   6
  321.       Top             =   1680
  322.       Width           =   615
  323.    End
  324.    Begin VB.Image Image2 
  325.       Height          =   465
  326.       Left            =   8040
  327.       Picture         =   "frmMain.frx":7120A
  328.       Top             =   1080
  329.       Width           =   465
  330.    End
  331.    Begin VB.Menu mnuGame 
  332.       Caption         =   "&Game"
  333.       Begin VB.Menu mnuNewGame 
  334.          Caption         =   "&New Game"
  335.          Shortcut        =   {F2}
  336.       End
  337.       Begin VB.Menu mnuLoad 
  338.          Caption         =   "&Load Game..."
  339.       End
  340.       Begin VB.Menu mnuSave 
  341.          Caption         =   "&Save Game..."
  342.       End
  343.       Begin VB.Menu sepetator3 
  344.          Caption         =   "-"
  345.       End
  346.       Begin VB.Menu mnuMoveNow 
  347.          Caption         =   "&Move Now"
  348.          Shortcut        =   {F3}
  349.       End
  350.       Begin VB.Menu mnuUndo 
  351.          Caption         =   "&Undo Move"
  352.       End
  353.       Begin VB.Menu mnuRedo 
  354.          Caption         =   "&Redo Move"
  355.       End
  356.       Begin VB.Menu seperator4 
  357.          Caption         =   "-"
  358.       End
  359.       Begin VB.Menu mnuExit 
  360.          Caption         =   "&Exit"
  361.       End
  362.    End
  363.    Begin VB.Menu mnuOptions 
  364.       Caption         =   "&Options"
  365.       Begin VB.Menu mnuComputer 
  366.          Caption         =   "Player vs &Computer"
  367.          Checked         =   -1  'True
  368.       End
  369.       Begin VB.Menu mnuPlayer 
  370.          Caption         =   "Player vs &Player"
  371.       End
  372.       Begin VB.Menu seperator1 
  373.          Caption         =   "-"
  374.       End
  375.       Begin VB.Menu mnuskill 
  376.          Caption         =   "Computer &Skill"
  377.          Begin VB.Menu mnuskilllevel 
  378.             Caption         =   "&Beginner"
  379.             Index           =   0
  380.          End
  381.          Begin VB.Menu mnuskilllevel 
  382.             Caption         =   "&Intermediate"
  383.             Index           =   1
  384.          End
  385.          Begin VB.Menu mnuskilllevel 
  386.             Caption         =   "&Good"
  387.             Checked         =   -1  'True
  388.             Index           =   2
  389.          End
  390.          Begin VB.Menu mnuskilllevel 
  391.             Caption         =   "&Expert"
  392.             Index           =   3
  393.          End
  394.          Begin VB.Menu mnuskilllevel 
  395.             Caption         =   "&Master"
  396.             Index           =   4
  397.          End
  398.          Begin VB.Menu mnuskilllevel 
  399.             Caption         =   "&Search Win/Loss"
  400.             Index           =   5
  401.          End
  402.          Begin VB.Menu mnuskilllevel 
  403.             Caption         =   "-"
  404.             Index           =   6
  405.          End
  406.          Begin VB.Menu mnuskilllevel 
  407.             Caption         =   "C&ustomize..."
  408.             Index           =   7
  409.          End
  410.       End
  411.    End
  412. End
  413. Attribute VB_Name = "frmMain"
  414. Attribute VB_GlobalNameSpace = False
  415. Attribute VB_Creatable = False
  416. Attribute VB_PredeclaredId = True
  417. Attribute VB_Exposed = False
  418. Option Explicit
  419. Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
  420. Dim Board(1 To 7, 1 To 6) As Integer ' 0=empty, 1=yellow, -1=red
  421. Dim PiecesInColumn(1 To 7) As Integer ' number of pieces in the column
  422. Dim MovesList(1 To 42) As Integer, MovesNum As Integer, SaveMovesNum As Integer  ' stores moves as column numbers
  423. Dim AllowMoving As Boolean ' is the user allowed to enter his move now?
  424. Dim IsGameOver As Boolean
  425. Dim PlayerToGo As Integer, SearchPlayerToGo As Integer '1=yellow, -1=red
  426. Dim StartDepth As Integer ' The depth of the search
  427. Dim Nodes As Long
  428. Dim LegalMovesList(1 To 7) As Integer, LegalMovesNum As Integer
  429. Dim YellowKiller As Integer, RedKiller As Integer
  430. Dim LastPVar(1 To 30) As Integer
  431. Dim StopThinking As Boolean, SaveTimer As Double
  432. Dim MovesValues(1 To 7) As Integer, SaveMovesValues(1 To 7) As Integer, HighestValue As Integer
  433. Dim SearchWin As Boolean, SearchWinMove As Integer
  434. Private Sub NewGame()
  435. Dim i As Integer, j As Integer
  436. For i = 1 To 7
  437.     For j = 1 To 6
  438.         Board(i, j) = 0
  439.     Next
  440. Next
  441. For i = 1 To 7
  442.     PiecesInColumn(i) = 0
  443. Next
  444. For i = 1 To 42
  445.     MovesList(i) = 0
  446. Next
  447. MovesNum = 0
  448. AllowMoving = True
  449. IsGameOver = False
  450. PlayerToGo = 1
  451. Image2.Visible = True: Image3.Visible = False
  452. Paintboard
  453. Label4.Caption = "": Label5.Caption = ""
  454. Text1.Text = ""
  455. End Sub
  456. Private Sub UpdateMovesList()
  457. Dim TempPiecesInColumn(1 To 7) As Integer, ColumnNo As Integer, Letter As String, i As Integer
  458. Text1.Text = ""
  459. For i = 1 To MovesNum
  460.     ColumnNo = MovesList(i)
  461.     Select Case ColumnNo
  462.         Case 1: Letter = "A"
  463.         Case 2: Letter = "B"
  464.         Case 3: Letter = "C"
  465.         Case 4: Letter = "D"
  466.         Case 5: Letter = "E"
  467.         Case 6: Letter = "F"
  468.         Case 7: Letter = "G"
  469.     End Select
  470.     TempPiecesInColumn(ColumnNo) = TempPiecesInColumn(ColumnNo) + 1
  471.     Letter = Str(i) + "." + Letter + Str(TempPiecesInColumn(ColumnNo))
  472.     Letter = Replace(Letter, " ", "")
  473.     If i Mod 2 = 1 Then Text1.Text = Text1.Text + Letter + vbTab Else Text1.Text = Text1.Text + Letter + vbCrLf
  474. Next
  475. End Sub
  476. Private Sub ArrayMakeMove(Column As Integer, Player As Integer)  'makes a move in the arrays of information, Player: 1=yellow, -1=red
  477. PiecesInColumn(Column) = PiecesInColumn(Column) + 1
  478. Board(Column, PiecesInColumn(Column)) = Player
  479. MovesNum = MovesNum + 1
  480. MovesList(MovesNum) = Column
  481. SearchPlayerToGo = -SearchPlayerToGo
  482. End Sub
  483. Private Sub ArrayUnmakeMove(Column As Integer)  'unmakes a move in the arrays of information
  484. Board(Column, PiecesInColumn(Column)) = 0
  485. PiecesInColumn(Column) = PiecesInColumn(Column) - 1
  486. MovesNum = MovesNum - 1
  487. SearchPlayerToGo = -SearchPlayerToGo
  488. End Sub
  489. Private Sub MakeMove(Column As Integer)
  490. AllowMoving = False
  491. Dim i As Integer
  492. For i = 6 To PiecesInColumn(Column) + 1 Step -1
  493.     Call PaintCell(Column, i, PlayerToGo)
  494.     If i < 6 Then Call PaintCell(Column, i + 1, 0)
  495.     DoEvents
  496.     Sleep (40)
  497. Next
  498. Call ArrayMakeMove(Column, PlayerToGo)
  499. Paintboard
  500. UpdateMovesList
  501. If CheckWin(Column, PiecesInColumn(Column)) = True Then IsGameOver = True: BlinkWin (Column)
  502. If MovesNum = 42 Then IsGameOver = True
  503. PlayerToGo = -PlayerToGo
  504. If IsGameOver = False Then
  505.     If PlayerToGo = 1 Then Image2.Visible = True: Image3.Visible = False Else Image3.Visible = True: Image2.Visible = False
  506. Else
  507.     Image2.Visible = False: Image3.Visible = False
  508. End If
  509. SaveMovesNum = MovesNum
  510. AllowMoving = True
  511. End Sub
  512. Private Sub BlinkWin(ColumnNo As Integer)
  513. Dim BlinkingCells(1 To 15, 1 To 2) As Integer '1 for x coordinates,2 for y coordinates
  514. Dim BlinkingCellsNum As Integer
  515. Dim TempBlinkingCells(1 To 6, 1 To 2) As Integer, TempNum As Integer
  516. Dim ChainLength As Integer, i As Integer, j As Integer
  517. Dim Height As Integer
  518.  
  519. AllowMoving = False
  520.  
  521. Height = PiecesInColumn(ColumnNo)
  522. BlinkingCells(1, 1) = ColumnNo
  523. BlinkingCells(1, 2) = Height
  524. BlinkingCellsNum = 1
  525.  
  526. 'vertical
  527. If PiecesInColumn(ColumnNo) >= 4 Then
  528.     If Board(ColumnNo, Height - 1) = Board(ColumnNo, Height) And Board(ColumnNo, Height - 2) = Board(ColumnNo, Height) And Board(ColumnNo, Height - 3) = Board(ColumnNo, Height) Then
  529.         BlinkingCells(2, 1) = ColumnNo: BlinkingCells(2, 2) = Height - 1
  530.         BlinkingCells(3, 1) = ColumnNo: BlinkingCells(3, 2) = Height - 2
  531.         BlinkingCells(4, 1) = ColumnNo: BlinkingCells(4, 2) = Height - 3
  532.         BlinkingCellsNum = 4
  533.     End If
  534. End If
  535.  
  536. 'horizontal
  537. ChainLength = 1
  538. TempNum = 0
  539. For i = ColumnNo + 1 To 7
  540.     If Board(i, Height) = Board(ColumnNo, Height) Then ChainLength = ChainLength + 1: TempNum = TempNum + 1: TempBlinkingCells(TempNum, 1) = i: TempBlinkingCells(TempNum, 2) = Height Else: Exit For
  541. Next
  542. For i = ColumnNo - 1 To 1 Step -1
  543.     If Board(i, Height) = Board(ColumnNo, Height) Then ChainLength = ChainLength + 1: TempNum = TempNum + 1: TempBlinkingCells(TempNum, 1) = i: TempBlinkingCells(TempNum, 2) = Height Else: Exit For
  544. Next
  545. If ChainLength >= 4 Then
  546.     For i = 1 To TempNum
  547.         BlinkingCellsNum = BlinkingCellsNum + 1
  548.         BlinkingCells(BlinkingCellsNum, 1) = TempBlinkingCells(i, 1)
  549.         BlinkingCells(BlinkingCellsNum, 2) = TempBlinkingCells(i, 2)
  550.     Next
  551. End If
  552.  
  553. 'diagonal up
  554. ChainLength = 1
  555. TempNum = 0
  556. For i = ColumnNo + 1 To 7
  557.     If (Height + i - ColumnNo) > 6 Then Exit For
  558.     If Board(i, Height + i - ColumnNo) = Board(ColumnNo, Height) Then ChainLength = ChainLength + 1: TempNum = TempNum + 1: TempBlinkingCells(TempNum, 1) = i: TempBlinkingCells(TempNum, 2) = Height + i - ColumnNo Else: Exit For
  559. Next
  560. For i = ColumnNo - 1 To 1 Step -1
  561.     If (Height - ColumnNo + i) < 1 Then Exit For
  562.     If Board(i, Height - ColumnNo + i) = Board(ColumnNo, Height) Then ChainLength = ChainLength + 1: TempNum = TempNum + 1: TempBlinkingCells(TempNum, 1) = i: TempBlinkingCells(TempNum, 2) = Height - ColumnNo + i Else: Exit For
  563. Next
  564. If ChainLength >= 4 Then
  565.     For i = 1 To TempNum
  566.         BlinkingCellsNum = BlinkingCellsNum + 1
  567.         BlinkingCells(BlinkingCellsNum, 1) = TempBlinkingCells(i, 1)
  568.         BlinkingCells(BlinkingCellsNum, 2) = TempBlinkingCells(i, 2)
  569.     Next
  570. End If
  571.  
  572. 'diagonal down
  573. ChainLength = 1
  574. TempNum = 0
  575. For i = ColumnNo + 1 To 7
  576.     If (Height - i + ColumnNo) < 1 Then Exit For
  577.     If Board(i, Height - i + ColumnNo) = Board(ColumnNo, Height) Then ChainLength = ChainLength + 1: TempNum = TempNum + 1: TempBlinkingCells(TempNum, 1) = i: TempBlinkingCells(TempNum, 2) = Height - i + ColumnNo Else: Exit For
  578. Next
  579. For i = ColumnNo - 1 To 1 Step -1
  580.     If (Height + ColumnNo - i) > 6 Then Exit For
  581.     If Board(i, Height + ColumnNo - i) = Board(ColumnNo, Height) Then ChainLength = ChainLength + 1: TempNum = TempNum + 1: TempBlinkingCells(TempNum, 1) = i: TempBlinkingCells(TempNum, 2) = Height + ColumnNo - i Else: Exit For
  582. Next
  583. If ChainLength >= 4 Then
  584.     For i = 1 To TempNum
  585.         BlinkingCellsNum = BlinkingCellsNum + 1
  586.         BlinkingCells(BlinkingCellsNum, 1) = TempBlinkingCells(i, 1)
  587.         BlinkingCells(BlinkingCellsNum, 2) = TempBlinkingCells(i, 2)
  588.     Next
  589. End If
  590.  
  591. For j = 1 To 4
  592.     For i = 1 To BlinkingCellsNum
  593.         Call PaintCell(BlinkingCells(i, 1), BlinkingCells(i, 2), 0)
  594.     Next
  595.     DoEvents
  596.     Sleep (200)
  597.     For i = 1 To BlinkingCellsNum
  598.         Call PaintCell(BlinkingCells(i, 1), BlinkingCells(i, 2), PlayerToGo)
  599.     Next
  600.     DoEvents
  601.     Sleep (200)
  602. Next
  603.  
  604. AllowMoving = True
  605.  
  606. End Sub
  607. Private Sub ComputerMove()
  608. Dim i As Integer, PVar(1 To 30) As Byte
  609. If mnuskilllevel(4).Checked = True Then
  610.     Select Case MovesNum
  611.         Case 0 To 17
  612.             TimeLimit = 10
  613.             DepthLimit = 30
  614.             EvalFunc = 3
  615.             SearchWin = False
  616.         Case 18 To 26
  617.             TimeLimit = 180
  618.             DepthLimit = 30
  619.             EvalFunc = 0
  620.             SearchWin = True
  621.         Case 27 To 42
  622.             TimeLimit = 180
  623.             DepthLimit = 30
  624.             EvalFunc = 0
  625.             SearchWin = False
  626.     End Select
  627. End If
  628.             
  629. Nodes = 0
  630. SearchPlayerToGo = PlayerToGo
  631. StartDepth = 1
  632. StopThinking = False
  633. SaveTimer = Timer
  634. Dim Value As Integer
  635. frmMain.MousePointer = 11: AllowMoving = False
  636. Do
  637.     StartDepth = Minimum(StartDepth, 42 - MovesNum)
  638.     YellowKiller = 0: RedKiller = 0
  639.     HighestValue = -20000
  640.     Value = Search(StartDepth, -10000, 10000, PVar())
  641.     If StopThinking = False Then
  642.         For i = 1 To 7
  643.             SaveMovesValues(i) = MovesValues(i)
  644.         Next
  645.         For i = 1 To StartDepth
  646.             LastPVar(i) = PVar(i)
  647.         Next
  648.         StartDepth = StartDepth + 1
  649.     End If
  650.     Label4.Caption = StartDepth - 1
  651.     Label5.Caption = HighestValue
  652.     If HighestValue > 4000 Then Label5.Caption = "Win"
  653.     If HighestValue < -4000 Then Label5.Caption = "Loss"
  654.  
  655.     If StopThinking = True Then Exit Do
  656.     If StartDepth > (36 - MovesNum) Then Exit Do
  657.     If Timer - SaveTimer > TimeLimit Then Exit Do
  658.     If StartDepth > DepthLimit Then Exit Do
  659.     If Value > 4000 Or Value < -4000 Then Exit Do
  660. Loop
  661. frmMain.MousePointer = 0: AllowMoving = True
  662. 'frmMain.Caption = Str(Value)
  663. Dim BestMoves(1 To 7) As Integer, BestMovesNum As Integer, SelectedMove As Integer
  664. HighestValue = -20000
  665. BestMovesNum = 0
  666. For i = 1 To 7
  667.     If SaveMovesValues(i) > HighestValue And PiecesInColumn(i) < 6 Then HighestValue = SaveMovesValues(i)
  668. Next
  669. For i = 1 To 7
  670.     If SaveMovesValues(i) = HighestValue And PiecesInColumn(i) < 6 Then
  671.         BestMovesNum = BestMovesNum + 1
  672.         BestMoves(BestMovesNum) = i
  673.     End If
  674. Next
  675. Randomize
  676. SelectedMove = BestMoves(Int(Rnd * BestMovesNum) + 1)
  677. If SearchWin = True Then SelectedMove = SearchWinMove
  678.  
  679. Label4.Caption = StartDepth - 1
  680. Label5.Caption = HighestValue
  681. If HighestValue > 4000 Then Label5.Caption = "Win"
  682. If HighestValue < -4000 Then Label5.Caption = "Loss"
  683. If HighestValue = 0 And StartDepth - 1 >= 36 - MovesNum Then Label5.Caption = "Draw"
  684. MakeMove (SelectedMove)
  685. End Sub
  686. Private Function CheckWin(X As Integer, Y As Integer) As Boolean
  687. Dim ChainLength As Integer, i As Integer, j As Integer
  688. CheckWin = False
  689. If Y >= 4 Then ' Check for a vertical win
  690.     If Board(X, Y - 1) = Board(X, Y) And Board(X, Y - 2) = Board(X, Y) And Board(X, Y - 3) = Board(X, Y) Then CheckWin = True: Exit Function
  691. End If
  692.  
  693. ' Check for a horizontal win
  694. ChainLength = 1
  695. For i = X + 1 To 7
  696.     If Board(i, Y) = Board(X, Y) Then ChainLength = ChainLength + 1 Else: Exit For
  697. Next
  698. For i = X - 1 To 1 Step -1
  699.     If Board(i, Y) = Board(X, Y) Then ChainLength = ChainLength + 1 Else: Exit For
  700. Next
  701. If ChainLength >= 4 Then CheckWin = True: Exit Function
  702.  
  703. 'Diagonal up
  704. ChainLength = 1
  705. For i = X + 1 To 7
  706.     If (Y + i - X) > 6 Then Exit For
  707.     If Board(i, Y + i - X) = Board(X, Y) Then ChainLength = ChainLength + 1 Else: Exit For
  708. Next
  709. For i = X - 1 To 1 Step -1
  710.     If (Y - X + i) < 1 Then Exit For
  711.     If Board(i, Y - X + i) = Board(X, Y) Then ChainLength = ChainLength + 1 Else: Exit For
  712. Next
  713. If ChainLength >= 4 Then CheckWin = True: Exit Function
  714.  
  715. 'Diagonal down
  716. ChainLength = 1
  717. For i = X + 1 To 7
  718.     If (Y - i + X) < 1 Then Exit For
  719.     If Board(i, Y - i + X) = Board(X, Y) Then ChainLength = ChainLength + 1 Else: Exit For
  720. Next
  721. For i = X - 1 To 1 Step -1
  722.     If (Y + X - i) > 6 Then Exit For
  723.     If Board(i, Y + X - i) = Board(X, Y) Then ChainLength = ChainLength + 1 Else: Exit For
  724. Next
  725. If ChainLength >= 4 Then CheckWin = True: Exit Function
  726.  
  727. End Function
  728. Private Sub GenerateMoves(Depth As Integer)
  729. Dim i As Integer
  730. LegalMovesNum = 0
  731. Randomize
  732. If Rnd < 1 Or Depth < StartDepth Then 'to make the computer not play always the same moves
  733.     For i = 1 To 7
  734.         If PiecesInColumn(i) < 6 Then
  735.             LegalMovesNum = LegalMovesNum + 1
  736.             LegalMovesList(LegalMovesNum) = i
  737.         End If
  738.     Next
  739. Else
  740.     For i = 7 To 1 Step -1
  741.         If PiecesInColumn(i) < 6 Then
  742.             LegalMovesNum = LegalMovesNum + 1
  743.             LegalMovesList(LegalMovesNum) = i
  744.         End If
  745.     Next
  746. End If
  747. End Sub
  748. Private Sub OrderMoves(Depth As Integer)
  749. 'give each move a value
  750. Dim i As Integer, j As Integer, Values(1 To 7) As Integer
  751. Dim ColumnNum As Integer
  752. For i = 1 To LegalMovesNum
  753.     ColumnNum = LegalMovesList(i)
  754.     Select Case ColumnNum
  755.         Case 4
  756.             Values(i) = 15
  757.         Case 3, 5
  758.             Values(i) = 10
  759.         Case 2, 6
  760.             Values(i) = 5
  761.         Case 1, 7
  762.             Values(i) = 0
  763.     End Select
  764.     If YellowKiller = ColumnNum And SearchPlayerToGo = 1 Or RedKiller = ColumnNum And SearchPlayerToGo = -1 Then Values(i) = 50
  765.     Board(ColumnNum, PiecesInColumn(ColumnNum) + 1) = 1
  766.     If CheckWin(ColumnNum, PiecesInColumn(ColumnNum) + 1) = True Then Values(i) = Values(i) + 100
  767.     Board(ColumnNum, PiecesInColumn(ColumnNum) + 1) = -1
  768.     If CheckWin(ColumnNum, PiecesInColumn(ColumnNum) + 1) = True Then Values(i) = Values(i) + 100
  769.     Board(ColumnNum, PiecesInColumn(ColumnNum) + 1) = 0
  770.     If Depth = StartDepth Then Values(i) = MovesValues(ColumnNum)
  771. Next
  772. 'sort the moves
  773. Dim LargestVal As Integer, BestNow As Integer, Temp As Integer
  774. For i = 1 To LegalMovesNum
  775. LargestVal = -10000
  776.     For j = i To LegalMovesNum
  777.     If Values(j) > LargestVal Then BestNow = j: LargestVal = Values(j)
  778.     Next
  779.     Temp = LegalMovesList(BestNow)
  780.     LegalMovesList(BestNow) = LegalMovesList(i)
  781.     LegalMovesList(i) = Temp
  782.     Values(BestNow) = Values(i)
  783. Next
  784.  
  785. End Sub
  786. Private Function Search(Depth As Integer, Alpha As Integer, Beta As Integer, ByRef PVar() As Byte)
  787. Dim Player As Integer, i As Integer, j As Integer, Score As Integer
  788. Dim ColumnNo As Integer, LegalMovesHere(1 To 7) As Integer
  789. Dim PVarHere(1 To 30) As Byte
  790.  
  791. If StopThinking = True Then Exit Function
  792. If Timer - SaveTimer > TimeLimit Then StopThinking = True: Exit Function
  793.  
  794. If (StartDepth - Depth) Mod 2 = 0 Then Player = PlayerToGo Else Player = -PlayerToGo
  795. If Depth < StartDepth Then
  796.     If CheckWin(MovesList(MovesNum), PiecesInColumn(MovesList(MovesNum))) = True Then Search = -5000 - Depth: Exit Function
  797. End If
  798. If Depth <= 0 Then
  799.     If MovesNum = 42 Then Search = 0: Exit Function
  800.     If MovesNum < 36 Then Search = EvaluateBoard(Player): Exit Function
  801. End If
  802. GenerateMoves (Depth)
  803. OrderMoves (Depth)
  804. For i = 1 To LegalMovesNum
  805.     LegalMovesHere(i) = LegalMovesList(i)
  806. Next
  807. For i = 1 To LegalMovesNum
  808.     Nodes = Nodes + 1: If Nodes Mod 1000 = 0 Then DoEvents
  809.     ColumnNo = LegalMovesHere(i)
  810.     Call ArrayMakeMove(ColumnNo, Player)
  811.     If Depth = StartDepth Then
  812.         Score = -Search(Depth - 1, -10000, 10000, PVar())
  813.     Else
  814.         Score = -Search(Depth - 1, -Beta, -Alpha, PVar())
  815.     End If
  816.     
  817.     ArrayUnmakeMove (ColumnNo)
  818.     
  819.     If Score >= Beta Or (Score > -HighestValue And (StartDepth - Depth) = 1) Then
  820.         Search = Score
  821.         If SearchPlayerToGo = 1 Then YellowKiller = ColumnNo Else RedKiller = ColumnNo
  822.         Exit Function
  823.     End If
  824.     If Score > Alpha Then
  825.         Alpha = Score
  826.         PVarHere(StartDepth - Depth + 1) = ColumnNo
  827.         For j = StartDepth - Depth + 2 To StartDepth
  828.             PVarHere(j) = PVar(j)
  829.         Next
  830.         If Depth = StartDepth Then HighestValue = Alpha
  831.         If Depth = StartDepth And SearchWin = True Then SearchWinMove = ColumnNo
  832.     End If
  833.     If Depth = StartDepth Then MovesValues(ColumnNo) = Score
  834.     If Score > 1 And SearchWin = True Then Search = Score: Exit Function
  835.     If Score = 0 And Depth Mod 2 = 0 And SearchWin = True And StartDepth < (36 - MovesNum) Then Search = Score: Exit Function
  836. Next
  837. For j = StartDepth - Depth + 1 To StartDepth
  838.     PVar(j) = PVarHere(j)
  839. Next
  840. Search = Alpha
  841. End Function
  842. Private Function EvaluateBoard(Player As Integer)
  843. Dim X As Integer, Y As Integer, i As Integer, j As Integer
  844. Dim NumYellow As Integer, NumRed As Integer, EmptyX As Integer, EmptyY As Integer
  845. Dim Value As Integer
  846. Dim YellowThreats(1 To 7, 1 To 6) As Integer, RedThreats(1 To 7, 1 To 6) As Integer
  847. Dim YellowOddThreatsNum As Integer, RedOddThreatsNum As Integer, FreeOddRed As Integer, FreeOddYellow As Integer, RedEvenThreatsNum As Integer
  848. Value = 0
  849. 'threats
  850. If EvalFunc >= 2 Then
  851. 'horizontal
  852. For X = 1 To 4
  853.     For Y = 1 To 6
  854.         NumYellow = 0: NumRed = 0
  855.         For i = 0 To 3
  856.             If Board(X + i, Y) = 1 Then NumYellow = NumYellow + 1
  857.             If Board(X + i, Y) = -1 Then NumRed = NumRed + 1
  858.             If Board(X + i, Y) = 0 Then EmptyX = X + i: EmptyY = Y
  859.         Next
  860.         If NumYellow = 3 And NumRed = 0 Then Value = Value + IIf(EmptyY Mod 2 = 1, 50, 20): YellowThreats(EmptyX, EmptyY) = 1
  861.         If NumYellow = 0 And NumRed = 3 Then Value = Value - IIf(EmptyY Mod 2 = 0, 50, 20): RedThreats(EmptyX, EmptyY) = 1
  862.         If NumYellow = 2 And NumRed = 0 Then Value = Value + 8
  863.         If NumYellow = 0 And NumRed = 2 Then Value = Value - 8
  864.     Next
  865. Next
  866.  
  867. 'diagonal up
  868. For X = 1 To 4
  869.     For Y = 1 To 3
  870.         NumYellow = 0: NumRed = 0
  871.         For i = 0 To 3
  872.             If Board(X + i, Y + i) = 1 Then NumYellow = NumYellow + 1
  873.             If Board(X + i, Y + i) = -1 Then NumRed = NumRed + 1
  874.             If Board(X + i, Y + i) = 0 Then EmptyX = X + i: EmptyY = Y + i
  875.         Next
  876.         If NumYellow = 3 And NumRed = 0 Then Value = Value + IIf(EmptyY Mod 2 = 1, 50, 20): YellowThreats(EmptyX, EmptyY) = 1
  877.         If NumYellow = 0 And NumRed = 3 Then Value = Value - IIf(EmptyY Mod 2 = 0, 50, 20): RedThreats(EmptyX, EmptyY) = 1
  878.         If NumYellow = 2 And NumRed = 0 Then Value = Value + 8
  879.         If NumYellow = 0 And NumRed = 2 Then Value = Value - 8
  880.     Next
  881. Next
  882.  
  883. 'diagonal down
  884. For X = 1 To 4
  885.     For Y = 4 To 6
  886.         NumYellow = 0: NumRed = 0
  887.         For i = 0 To 3
  888.             If Board(X + i, Y - i) = 1 Then NumYellow = NumYellow + 1
  889.             If Board(X + i, Y - i) = -1 Then NumRed = NumRed + 1
  890.             If Board(X + i, Y - i) = 0 Then EmptyX = X + i: EmptyY = Y - i
  891.         Next
  892.         If NumYellow = 3 And NumRed = 0 Then Value = Value + IIf(EmptyY Mod 2 = 1, 50, 20): YellowThreats(EmptyX, EmptyY) = 1
  893.         If NumYellow = 0 And NumRed = 3 Then Value = Value - IIf(EmptyY Mod 2 = 0, 50, 20): RedThreats(EmptyX, EmptyY) = 1
  894.         If NumYellow = 2 And NumRed = 0 Then Value = Value + 8
  895.         If NumYellow = 0 And NumRed = 2 Then Value = Value - 8
  896.     Next
  897. Next
  898.  
  899. End If 'If EvalFunc........
  900.  
  901. If EvalFunc = 3 Then
  902.  
  903. Dim CountRedOdd As Boolean
  904. For i = 1 To 7
  905.     CountRedOdd = True
  906.     For j = 2 To 6
  907.         If YellowThreats(i, j) = 1 And j Mod 2 = 1 And Board(i, j - 1) = 0 Then
  908.             YellowOddThreatsNum = YellowOddThreatsNum + 1
  909.             If RedThreats(i, j) = 1 And YellowThreats(i, j - 1) = 0 Then RedOddThreatsNum = RedOddThreatsNum + 1
  910.             Exit For
  911.         End If
  912.         
  913.         If RedThreats(i, j) = 1 And j Mod 2 = 0 And Board(i, j - 1) = 0 Then RedEvenThreatsNum = RedEvenThreatsNum + 1: Exit For
  914.         If CountRedOdd = True And RedThreats(i, j) = 1 And YellowThreats(i, j) = 0 And YellowThreats(i, j - 1) = 0 And j Mod 2 = 1 And Board(i, j - 1) = 0 Then RedOddThreatsNum = RedOddThreatsNum + 1: FreeOddRed = FreeOddRed + 1: CountRedOdd = False
  915.         
  916.         If YellowThreats(i, j) = 1 And Board(i, j - 1) <> 0 And SearchPlayerToGo = 1 Then Value = Value + 2000
  917.         If RedThreats(i, j) = 1 And Board(i, j - 1) <> 0 And SearchPlayerToGo = -1 Then Value = Value - 2000
  918.     
  919.     Next
  920. Next
  921. FreeOddYellow = YellowOddThreatsNum - (RedOddThreatsNum - FreeOddRed)
  922. 'If YellowOddThreatsNum >= 1 And FreeOddRed = 0 And RedOddThreatsNum < 2 Then Value = Value + 500
  923. If YellowOddThreatsNum > RedOddThreatsNum Then Value = Value + 500
  924. If FreeOddYellow = 0 And RedOddThreatsNum >= 2 Then Value = Value - 500
  925. If RedEvenThreatsNum >= 1 And FreeOddRed >= YellowOddThreatsNum Then Value = Value - 500
  926.  
  927. End If 'If EvalFunc........
  928.  
  929. If EvalFunc >= 1 Then
  930.  
  931. For i = Maximum(MovesNum - StartDepth + 1, 1) To MovesNum
  932.     Select Case MovesList(i)
  933.         Case 4
  934.             Value = Value + 20 * PlayerToGo * IIf((i - (MovesNum - StartDepth + 1)) Mod 2 = 0, 1, -1)
  935.         Case 3, 5
  936.             Value = Value + 10 * PlayerToGo * IIf((i - (MovesNum - StartDepth + 1)) Mod 2 = 0, 1, -1)
  937.         Case 2, 6
  938.             Value = Value + 5 * PlayerToGo * IIf((i - (MovesNum - StartDepth + 1)) Mod 2 = 0, 1, -1)
  939.     End Select
  940. Next
  941.  
  942. End If 'If EvalFunc........
  943.  
  944. EvaluateBoard = Value * Player
  945. End Function
  946. '''''''''''''''''''''''''''''''''''''''''''
  947. Private Function Maximum(x1 As Integer, x2 As Integer) As Integer
  948. If x1 > x2 Then Maximum = x1 Else Maximum = x2
  949. End Function
  950. Private Function Minimum(x1 As Integer, x2 As Integer) As Integer
  951. If x1 < x2 Then Minimum = x1 Else Minimum = x2
  952. End Function
  953. Private Sub Paintboard()
  954. Dim i As Integer, j As Integer
  955. Picboard.Cls
  956. For i = 1 To 7
  957.     For j = 1 To 6
  958.         Call PaintCell(i, j, Board(i, j))
  959.         'If Board(i, j) = 1 Then Picboard.PaintPicture PicPieces.Picture, (i - 1) * 46 + 75.8, (6 - j) * 39.5 + 13, 40, 40, 0, 40, 40, 40  'draw a yellow piece
  960.         'If Board(i, j) = -1 Then Picboard.PaintPicture PicPieces.Picture, (i - 1) * 46 + 75.8, (6 - j) * 39.5 + 13, 40, 40, 0, 79, 40, 40 'draw a red piece
  961.     Next
  962. Next
  963. End Sub
  964. Private Sub PaintCell(X As Integer, Y As Integer, Color As Integer)
  965. If Color = 1 Then Picboard.PaintPicture PicPieces.Picture, (X - 1) * 46 + 75.8, (6 - Y) * 39.5 + 13, 40, 40, 0, 40, 40, 40 'draw a yellow piece
  966. If Color = -1 Then Picboard.PaintPicture PicPieces.Picture, (X - 1) * 46 + 75.8, (6 - Y) * 39.5 + 13, 40, 40, 0, 79, 40, 40 'draw a red piece
  967. If Color = 0 Then Picboard.PaintPicture PicPieces.Picture, (X - 1) * 46 + 75.8, (6 - Y) * 39.5 + 13, 40, 40, 0, 118, 40, 40 'draw a blank cell
  968. End Sub
  969. Private Sub Form_Load()
  970. NewGame
  971. mnuSkillLevel_Click (2)
  972. CommonDialog1.Flags = (cdlOFNPathMustExist Or cdlOFNOverwritePrompt)
  973. End Sub
  974.  
  975. Private Sub Form_Unload(Cancel As Integer)
  976. End
  977. End Sub
  978.  
  979. Private Sub Image1_Click(Index As Integer)
  980. If AllowMoving = True And IsGameOver = False And PiecesInColumn(Index + 1) < 6 Then
  981.     MakeMove (Index + 1)
  982.     If mnuComputer.Checked = True And IsGameOver = False Then DoEvents: ComputerMove
  983. End If
  984. End Sub
  985.  
  986. Private Sub mnuComputer_Click()
  987. mnuComputer.Checked = True
  988. mnuPlayer.Checked = False
  989. End Sub
  990.  
  991. Private Sub mnuExit_Click()
  992. End
  993. End Sub
  994.  
  995. Private Sub mnuLoad_Click()
  996. On Error GoTo Errr
  997. Dim StrGame As String, i As Integer
  998. CommonDialog1.Filter = "Connect Four Game Files |*.cfgf|"
  999. CommonDialog1.ShowOpen
  1000. If CommonDialog1.FileName = "" Then Exit Sub
  1001. Open CommonDialog1.FileName For Input As #1
  1002. Input #1, StrGame
  1003. Close #1
  1004. NewGame
  1005. For i = 1 To Len(StrGame)
  1006.     Call ArrayMakeMove(Mid(StrGame, i, 1), PlayerToGo)
  1007.     PlayerToGo = -PlayerToGo
  1008. Next
  1009. Paintboard
  1010. UpdateMovesList
  1011. If MovesNum = 42 Then IsGameOver = True
  1012. SaveMovesNum = MovesNum
  1013. If CheckWin(Mid(StrGame, Len(StrGame), 1), PiecesInColumn(Mid(StrGame, Len(StrGame), 1))) = True Then IsGameOver = True
  1014. If IsGameOver = False Then
  1015.     If PlayerToGo = 1 Then Image2.Visible = True: Image3.Visible = False Else Image3.Visible = True: Image2.Visible = False
  1016. Else
  1017.     Image2.Visible = False: Image3.Visible = False
  1018. End If
  1019. Exit Sub
  1020. Errr:
  1021. MsgBox (Err.Description)
  1022. Exit Sub
  1023. End Sub
  1024.  
  1025. Private Sub mnuMoveNow_Click()
  1026. If IsGameOver = False And AllowMoving = True Then ComputerMove
  1027. End Sub
  1028.  
  1029. Private Sub mnuNewGame_Click()
  1030. If AllowMoving = True Then NewGame
  1031. End Sub
  1032.  
  1033. Private Sub mnuPlayer_Click()
  1034. mnuPlayer.Checked = True
  1035. mnuComputer.Checked = False
  1036. End Sub
  1037.  
  1038. Private Sub mnuRedo_Click()
  1039. Dim Column As Integer
  1040. If MovesNum = SaveMovesNum Then Exit Sub
  1041. Column = MovesList(MovesNum + 1)
  1042. Board(Column, PiecesInColumn(Column) + 1) = PlayerToGo
  1043. PiecesInColumn(Column) = PiecesInColumn(Column) + 1
  1044. MovesNum = MovesNum + 1
  1045. Paintboard
  1046. UpdateMovesList
  1047. If CheckWin(Column, PiecesInColumn(Column)) = True Then IsGameOver = True: DoEvents: Sleep (200): BlinkWin (Column)
  1048. If MovesNum = 42 Then IsGameOver = True
  1049. PlayerToGo = -PlayerToGo
  1050. If IsGameOver = False Then
  1051.     If PlayerToGo = 1 Then Image2.Visible = True: Image3.Visible = False Else Image3.Visible = True: Image2.Visible = False
  1052. Else
  1053.     Image2.Visible = False: Image3.Visible = False
  1054. End If
  1055. End Sub
  1056.  
  1057. Private Sub mnuSave_Click()
  1058. On Error GoTo Errr
  1059. Dim i As Integer, StrGame As String
  1060. StrGame = ""
  1061. For i = 1 To SaveMovesNum
  1062.     StrGame = StrGame + Str(MovesList(i))
  1063. Next
  1064. StrGame = Replace(StrGame, " ", "")
  1065. CommonDialog1.Filter = "Connect Four Game Files |*.cfgf|"
  1066. CommonDialog1.ShowSave
  1067. If CommonDialog1.FileName = "" Then Exit Sub
  1068. Open CommonDialog1.FileName For Output As #1
  1069. Write #1, StrGame
  1070. Close #1
  1071. Exit Sub
  1072. Errr:
  1073. MsgBox (Err.Description)
  1074. Exit Sub
  1075. End Sub
  1076.  
  1077. Private Sub mnuSkillLevel_Click(Index As Integer)
  1078. Dim i As Integer
  1079. For i = 0 To 7
  1080.     If i = Index Then mnuskilllevel(i).Checked = True Else mnuskilllevel(i).Checked = False
  1081. Next
  1082. If Index = 5 Then SearchWin = True Else SearchWin = False
  1083. If Index <> 7 Then
  1084.     TimeLimit = 5
  1085.     Select Case Index
  1086.     Case 0
  1087.         DepthLimit = 2
  1088.         EvalFunc = 1
  1089.     Case 1
  1090.         DepthLimit = 4
  1091.         EvalFunc = 1
  1092.     Case 2
  1093.         DepthLimit = 4
  1094.         EvalFunc = 3
  1095.     Case 3
  1096.         DepthLimit = 8
  1097.         EvalFunc = 3
  1098.     Case 4
  1099.         DepthLimit = 30
  1100.         TimeLimit = 180
  1101.         EvalFunc = 0
  1102.     End Select
  1103. Else
  1104.     Load frmAI
  1105.     frmAI.Show vbModal, frmMain
  1106. End If
  1107. End Sub
  1108.  
  1109.  
  1110. Private Sub mnuUndo_Click()
  1111. Dim Column As Integer
  1112. If MovesNum = 0 Then Exit Sub
  1113. IsGameOver = False
  1114. Column = MovesList(MovesNum)
  1115. Board(Column, PiecesInColumn(Column)) = 0
  1116. PiecesInColumn(Column) = PiecesInColumn(Column) - 1
  1117. MovesNum = MovesNum - 1
  1118. PlayerToGo = -PlayerToGo
  1119. If PlayerToGo = 1 Then Image2.Visible = True: Image3.Visible = False Else Image3.Visible = True: Image2.Visible = False
  1120. Paintboard
  1121. UpdateMovesList
  1122. End Sub
  1123.  
  1124. Private Sub Toolbar1_ButtonClick(ByVal Button As MSComctlLib.Button)
  1125. If AllowMoving = False And Button.Key <> "stop" Then Exit Sub
  1126. Select Case Button.Key
  1127.     Case "new"
  1128.         mnuNewGame_Click
  1129.     Case "load"
  1130.         mnuLoad_Click
  1131.     Case "save"
  1132.         mnuSave_Click
  1133.     Case "move"
  1134.         mnuMoveNow_Click
  1135.     Case "undo"
  1136.         mnuUndo_Click
  1137.     Case "redo"
  1138.         mnuRedo_Click
  1139.     Case "stop"
  1140.         StopThinking = True
  1141. End Select
  1142. End Sub
  1143.